home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / source8 / uimage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  16.9 KB  |  528 lines
  1. unit Uimage;
  2.  
  3. interface
  4. {Part of Imagelib VCL/DLL Library.
  5. Written by Jan Dekkers and Kevin Adams (c) 1995. If you are a non
  6. registered client, you may use or alter this demo only for evaluation
  7. purposes.
  8.  
  9. Uses ImageLib 2.2. Changed the callback to a function instead of a
  10. procedure to let the user cancel out. Added:
  11.  
  12. scrolling text images
  13. Cut, Copy and Paste to/from the clipboard
  14. Printing bitmaps}
  15.  
  16.  
  17. uses
  18.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  19.   Forms, Dialogs, StdCtrls, FileCtrl, TMulti, VBXCtrl, Switch, Spin,
  20.   Buttons, UFullscr, Menus, Uabout, ExtCtrls, Gauges, printers, U_p_size;
  21.  
  22.  
  23. type
  24.   TForm1 = class(TForm)
  25.     DriveComboBox1     : TDriveComboBox;
  26.     DirectoryListBox1  : TDirectoryListBox;
  27.     FileListBox1       : TFileListBox;
  28.     Sstretch           : TBiSwitch;
  29.     Label1             : TLabel;
  30.     SaveAs             : TBiSwitch;
  31.     Label4             : TLabel;
  32.     SaveDialog1        : TSaveDialog;
  33.     SaveButton         : TBitBtn;
  34.     QualitySpin        : TSpinEdit;
  35.     Smoothspin         : TSpinEdit;
  36.     QualityLabel       : TLabel;
  37.     SmoothLabel        : TLabel;
  38.     GroupBox1          : TGroupBox;
  39.     res4               : TRadioButton;
  40.     res24              : TRadioButton;
  41.     res8               : TRadioButton;
  42.     GroupBox2          : TGroupBox;
  43.     Label5             : TLabel;
  44.     Label6             : TLabel;
  45.     Label7             : TLabel;
  46.     DitherOneNo        : TRadioButton;
  47.     DitherOneYes       : TRadioButton;
  48.     DitherTwoNo        : TRadioButton;
  49.     DitherTwoYes       : TRadioButton;
  50.     Dither24Bit        : TRadioButton;
  51.     MainMenu1          : TMainMenu;
  52.     N1                 : TMenuItem;
  53.     O1                 : TMenuItem;
  54.     N2                 : TMenuItem;
  55.     N3                 : TMenuItem;
  56.     E1                 : TMenuItem;
  57.     A1                 : TMenuItem;
  58.     OpenDialog1        : TOpenDialog;
  59.     N4                 : TMenuItem;
  60.     Print1             : TMenuItem;
  61.     PrintSetup1        : TMenuItem;
  62.     PrinterSetupDialog1: TPrinterSetupDialog;
  63.     PrintDialog1       : TPrintDialog;
  64.     MultiImage1        : TMultiImage;
  65.     Gauge1             : TGauge;
  66.     Label9             : TLabel;
  67.     Label10            : TLabel;
  68.     Label11            : TLabel;
  69.     Label12            : TLabel;
  70.     Label13            : TLabel;
  71.     Label14            : TLabel;
  72.     Label15            : TLabel;
  73.     Edit1              : TEdit;
  74.     Edit2              : TEdit;
  75.     Edit3              : TEdit;
  76.     Edit4              : TEdit;
  77.     Edit5              : TEdit;
  78.     Edit6              : TEdit;
  79.     Edit7              : TEdit;
  80.     GetInfoChecked     : TCheckBox;
  81.     Label8             : TLabel;
  82.     Edit8              : TEdit;
  83.     CheckBox1          : TCheckBox;
  84.     BitBtn1            : TBitBtn;
  85.     Edit9: TMenuItem;
  86.     Cut1: TMenuItem;
  87.     Copy1: TMenuItem;
  88.     Paste1: TMenuItem;
  89.     ScrollBar1: TScrollBar;
  90.     N5: TMenuItem;
  91.     CreateMessage1: TMenuItem;
  92.     procedure DriveComboBox1Change(Sender: TObject);
  93.     procedure DirectoryListBox1Change(Sender: TObject);
  94.     procedure FileListBox1Change(Sender: TObject);
  95.     procedure SstretchOnOff(Sender: TObject);
  96.     procedure FormCreate(Sender: TObject);
  97.     procedure resClick(Sender: TObject);
  98.     procedure DitherClick(Sender: TObject);
  99.     procedure SaveButtonClick(Sender: TObject);
  100.     procedure MultiImage1Click(Sender: TObject);
  101.     procedure E1Click(Sender: TObject);
  102.     procedure O1Click(Sender: TObject);
  103.     procedure A1Click(Sender: TObject);
  104.     procedure setsavevisible(Sender: TObject);
  105.     procedure Print1Click(Sender: TObject);
  106.     procedure PrintSetup1Click(Sender: TObject);
  107.     procedure GetInfoCheckedClick(Sender: TObject);
  108.     procedure CheckBox1Click(Sender: TObject);
  109.     procedure BitBtn1Click(Sender: TObject);
  110.     procedure FormDestroy(Sender: TObject);
  111.     procedure Cut1Click(Sender: TObject);
  112.     procedure Copy1Click(Sender: TObject);
  113.     procedure Paste1Click(Sender: TObject);
  114.     procedure ScrollBar1Change(Sender: TObject);
  115.   private
  116.     { Private declarations }
  117.    oldsavefiles   : TstringList;
  118.    oldreadfiles   : TstringList;
  119.    procedure DisPlayInfo(dis : boolean);
  120.    Procedure Trigger(Sender : TObject; Var Done : Boolean);
  121.   public
  122.     { Public declarations }
  123.   end;
  124.  
  125. var
  126.   Form1: TForm1;
  127.  
  128. implementation
  129.  
  130. {$R *.DFM}
  131.  
  132. {---------------------------------------------------------------------}
  133.  
  134. {Changed in version 2.2 from a procedure to a function. To cancel return
  135. a 0 else return a 1}
  136. Function ImageLibCallBack(i : integer) : integer; export;
  137. {Callback function from the dll, EXPORT IS REQUIRED}
  138. begin
  139.  if Application.Terminated then begin
  140.    {User wants to terminate the program. Pass a 0 to the dll}
  141.    Result:=0;
  142.   end else begin
  143.   {Be nice to others <g>}
  144.    Application.ProcessMessages;
  145.    {process a Gauge}
  146.    Form1.Gauge1.Progress:=i;
  147.    {tell the dll that everything is OK}
  148.    Result:=1;
  149.    end;
  150. end;
  151. {---------------------------------------------------------------------}
  152.  
  153. procedure TForm1.DriveComboBox1Change(Sender: TObject);
  154. {update the drive of DirectoryListBox1 with the drive of DriveComboBox1}
  155. begin
  156.   DirectoryListBox1.Drive := DriveComboBox1.Drive;
  157. end;
  158. {---------------------------------------------------------------------}
  159.  
  160. procedure TForm1.DisPlayInfo(dis : boolean);
  161. begin
  162.     {If scrolling message then show the speed scroll bar}
  163.     if MultiImage1.BFileType = 'SCM' then begin
  164.     {Show it}
  165.      ScrollBar1.Visible:=true;
  166.      {set the speed/position}
  167.      ScrollBar1.Position:=MultiImage1.MsgSpeed;
  168.     end else
  169.      ScrollBar1.Visible:=False;
  170.  
  171. (*     {show or hide the jpeg options}
  172.      GroupBox1.Visible:=(MultiImage1.BFileType = 'JPEG');
  173.      GroupBox2.Visible:=(MultiImage1.BFileType = 'JPEG');
  174. *)
  175.  
  176.     if dis then begin
  177.        {display the image info}
  178.        Edit1.Text:=IntToStr(MultiImage1.Bwidth);
  179.        Edit2.Text:=IntToStr(MultiImage1.BHeight);
  180.        Edit3.Text:=IntToStr(MultiImage1.Bbitspixel);
  181.        Edit4.Text:=IntToStr(MultiImage1.Bplanes);
  182.        Edit5.Text:=IntToStr(MultiImage1.Bnumcolors);
  183.        Edit6.Text:=MultiImage1.BFileType;
  184.        Edit7.Text:=MultiImage1.Bcompression;
  185.        Edit8.Text:=IntToStr(MultiImage1.BSize);
  186.      end else begin
  187.       {set the image info to ''}
  188.        Edit1.Text:='';
  189.        Edit2.Text:='';
  190.        Edit3.Text:='';
  191.        Edit4.Text:='';
  192.        Edit5.Text:='';
  193.        Edit6.Text:='';
  194.        Edit7.Text:='';
  195.        Edit8.Text:='';
  196.      end;
  197. end;
  198. {---------------------------------------------------------------------}
  199.  
  200. procedure TForm1.DirectoryListBox1Change(Sender: TObject);
  201. {update the directory of FileListBox1 with the directory of FileListBox1}
  202. begin
  203.   FileListBox1.Directory := DirectoryListBox1.Directory;
  204. end;
  205. {---------------------------------------------------------------------}
  206.  
  207. procedure TForm1.FileListBox1Change(Sender: TObject);
  208. {Display the image of the FileListBox1.filename}
  209. begin
  210.  {set hourglass cursor}
  211.   screen.cursor:=crHourGlass;
  212.  
  213.  {delete the old image}
  214.   MultiImage1.imagename:='';
  215.  
  216.  {display an image using the vcl}
  217.   MultiImage1.imagename:=FileListBox1.filename;
  218.  
  219.   {Request fileinfo from the DLL}
  220.   {Note, fileinfo will not work on WMF and ICO}
  221.   if GetInfoChecked.Checked then
  222.    DisplayInfo(true) else DisplayInfo(false);
  223.  
  224.   {Reset the gauge}
  225.   Gauge1.Progress:=0;
  226.  
  227.  {add filename to the history list of the open dialog}
  228.   oldreadfiles.add(FileListBox1.filename);
  229.  
  230.  {copy the stringlist to the historylist}
  231.   OpenDialog1.historylist:=oldreadfiles;
  232.  
  233.   {set default cursor}
  234.   screen.cursor:=crDefault;
  235. end;
  236. {---------------------------------------------------------------------}
  237.  
  238. procedure TForm1.SstretchOnOff(Sender: TObject);
  239. {set strech mode}
  240. begin
  241.   MultiImage1.stretch:=Sstretch.Pon;
  242. end;
  243. {---------------------------------------------------------------------}
  244.  
  245. procedure TForm1.setsavevisible(Sender: TObject);
  246. {hide or show jpeg save options}
  247. begin
  248.     QualitySpin.visible:=SaveAs.Pon;
  249.     Smoothspin.visible:=SaveAs.Pon;
  250.     QualityLabel.visible:=SaveAs.Pon;
  251.     SmoothLabel.visible:=SaveAs.Pon;
  252. end;
  253. {---------------------------------------------------------------------}
  254.  
  255. procedure TForm1.FormCreate(Sender: TObject);
  256. {what we do on create}
  257. begin
  258.     {Define the callback procedure}
  259.     TMultiImageCallBack:=ImageLibCallBack;
  260.  
  261.     {set the value of the QualitySpin to the value of JPegSaveQuality}
  262.     QualitySpin.value:=MultiImage1.JPegSaveQuality;
  263.  
  264.     {set the value of the Smoothspin to the value of JPegSaveSmooth}
  265.     Smoothspin.value:=MultiImage1.JPegSaveSmooth;
  266.  
  267.     {show the save options depending on the saveas switch pon state}
  268.     setsavevisible(sender);
  269.  
  270.     {create temporary history stringlists}
  271.     oldsavefiles := TstringList.create;
  272.     oldreadfiles := TstringList.create;
  273.     {IMPORTANT}
  274.     {This is the moving engine for all the messages. Since an applcation
  275.     can have only one OnIdle Trigger, this trigger needs to be subdivided
  276.     by all your moving and animated objects. In this particular case the
  277.     function is called TRIGGER but you can name it as you want as long
  278.     you have a procedure named the same.}
  279.  
  280.     Application.OnIdle:=Trigger;
  281. end;
  282. {---------------------------------------------------------------------}
  283.  
  284. Procedure TForm1.Trigger(Sender : TObject; Var Done : Boolean);
  285. begin
  286.    {This function is called when your app is idle. Subdivide the
  287.     trigger event to your TMultiImage objects who may need one.
  288.     If no Message is active it will not take up significant time}
  289.     MultiImage1.Trigger;
  290. end;
  291. {---------------------------------------------------------------------}
  292.  
  293. procedure TForm1.resClick(Sender: TObject);
  294. {Set the jpeg resolution to either 16, 256 or true color in the vcl}
  295. begin
  296.  {set jpeg show resolution to 4 bit 16 color}
  297.  if res4.checked  then MultiImage1.JPegResolution:=4;
  298.  
  299.  {set jpeg show resolution to 8 bit 256 color}
  300.  if res8.checked  then MultiImage1.JPegResolution:=8;
  301.  
  302.  {set jpeg show resolution to 24 bit true color}
  303.  if res24.checked then MultiImage1.JPegResolution:=24;
  304. end;
  305. {---------------------------------------------------------------------}
  306.  
  307. procedure TForm1.DitherClick(Sender: TObject);
  308. {Set the jpeg dither in the vcl}
  309. begin
  310.   {set the jpeg show dither to none (best choice for true color 24 bit}
  311.   if Dither24Bit.checked  then MultiImage1.JPegDither:=0;
  312.  
  313.   {set the jpeg show dither to one pass none}
  314.   if DitherOneNo.checked  then MultiImage1.JPegDither:=1;
  315.  
  316.   {set the jpeg show dither to one pass dithered (best choice for 16 colors)}
  317.   if DitherOneYes.checked  then MultiImage1.JPegDither:=2;
  318.  
  319.   {set the jpeg show dither to one pass none}
  320.   if DitherTwoNo.checked  then MultiImage1.JPegDither:=3;
  321.  
  322.   {set the jpeg show dither to two pass dithered (best choice for 256 colors)}
  323.   if DitherTwoYes.checked  then MultiImage1.JPegDither:=4;
  324. end;
  325. {---------------------------------------------------------------------}
  326.  
  327. procedure TForm1.SaveButtonClick(Sender: TObject);
  328. {save a jpeg or bmp}
  329. begin
  330.  {Set various filters}
  331.  if MultiImage1.BFileType = 'SCM' then begin
  332.   SaveDialog1.Filename:='*.SCM';
  333.   SaveDialog1.Filter:='Scroll message|*.scm';
  334.  end else begin
  335.   SaveDialog1.Filename:='*.jpg';
  336.   SaveDialog1.Filter:='jpeg|*.jpg|bitmap|*.bmp';
  337.  end;
  338.  
  339.  {open save dialog}
  340.  if SaveDialog1.execute then begin
  341.  
  342.  {set hourglass cursor}
  343.   screen.cursor:=crHourGlass;
  344.  
  345.   {save it if the extension is jpg}
  346.   if UpperCase(ExtractFileExt(SaveDialog1.Filename)) =  '.JPG' then
  347.     MultiImage1.SaveAsJpg(SaveDialog1.FileName);
  348.  
  349.   {save it if the extension is bmp}
  350.   if UpperCase(ExtractFileExt(SaveDialog1.Filename)) =  '.BMP' then
  351.     MultiImage1.Picture.SaveToFile(SaveDialog1.FileName);
  352.  
  353.  {save it if the extension is SCM}
  354.   if UpperCase(ExtractFileExt(SaveDialog1.Filename)) =  '.SCM' then
  355.     MultiImage1.SaveCurrentMessage(SaveDialog1.FileName);
  356.  
  357.  {add filename to the history list of the save dialog}
  358.   oldSavefiles.add(SaveDialog1.filename);
  359.  
  360.  {copy the stringlist to the historylist}
  361.   SaveDialog1.historylist:=oldSavefiles;
  362.  
  363.  {set default cursor}
  364.   screen.cursor:=crDefault;
  365.  
  366.   {update the filelist box sothat the file saved shows up}
  367.   FileListBox1.Update;
  368.  end;
  369. end;
  370. {---------------------------------------------------------------------}
  371.  
  372. procedure TForm1.MultiImage1Click(Sender: TObject);
  373. {show fullscreen}
  374. begin
  375.   {copy image to fullscreen image}
  376.   FullSlide.MultiImage1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  377.   {show the image fulscreen}
  378.   FullSlide.showmodal;
  379. end;
  380. {---------------------------------------------------------------------}
  381.  
  382. procedure TForm1.E1Click(Sender: TObject);
  383. {exit the program}
  384. begin
  385.  close;
  386. end;
  387. {---------------------------------------------------------------------}
  388.  
  389. procedure TForm1.O1Click(Sender: TObject);
  390. {open a image using the open dialog}
  391. begin
  392.   if OpenDialog1.execute then begin
  393.  
  394.    {set hourglass cursor}
  395.     screen.cursor:=crHourGlass;
  396.  
  397.    {delete the old image}
  398.     MultiImage1.imagename:='';
  399.  
  400.     {display an image using the vcl}
  401.     MultiImage1.imagename:=OpenDialog1.filename;
  402.  
  403.    {Request fileinfo from the DLL}
  404.    {Note, fileinfo will not work on WMF and ICO}
  405.     if GetInfoChecked.Checked then
  406.       DisplayInfo(true) else DisplayInfo(false);
  407.  
  408.     {reset the gauge}
  409.     Gauge1.Progress:=0;
  410.  
  411.    {add filename to the history list of the open dialog}
  412.     oldreadfiles.add(OpenDialog1.filename);
  413.  
  414.    {copy the stringlist to the historylist}
  415.     OpenDialog1.historylist:=oldreadfiles;
  416.  
  417.    {set default cursor}
  418.     screen.cursor:=crDefault;
  419.   end;
  420. end;
  421. {---------------------------------------------------------------------}
  422.  
  423. procedure TForm1.A1Click(Sender: TObject);
  424. {about box}
  425. begin
  426. {Copy the image to the image of he about box}
  427.  AboutBox.Image1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  428. {show the about box}
  429.  AboutBox.showmodal;
  430. end;
  431. {---------------------------------------------------------------------}
  432.  
  433. procedure TForm1.Print1Click(Sender: TObject);
  434. {Print image}
  435. begin
  436.   if PrintDialog1.execute then begin
  437.   {Initialize the height spinedit of the printsize dialog box}
  438.    Printersize.HeigthSpinEdit.Value:=MultiImage1.Picture.Height;
  439.    {Initialize the width spinedit of the printsize dialog box}
  440.    Printersize.WidthSpinEdit.Value:=MultiImage1.Picture.Width;
  441.    {Show it}
  442.    Printersize.ShowModal;
  443.    if Printersize.Modalresult = mrok then
  444.     {print TMultiImage}
  445.      MultiImage1.PrintMultiImage(0,0,Printersize.WidthSpinEdit.Value,Printersize.HeigthSpinEdit.Value);
  446.    {Hide it if done}
  447.    Printersize.hide;
  448.   end;
  449. end;
  450. {---------------------------------------------------------------------}
  451.  
  452. procedure TForm1.PrintSetup1Click(Sender: TObject);
  453. {Set up printer}
  454. begin
  455.   PrinterSetupDialog1.Execute;
  456. end;
  457. {---------------------------------------------------------------------}
  458.  
  459. procedure TForm1.GetInfoCheckedClick(Sender: TObject);
  460. {depending on the state of the checkbox,  display or not display info}
  461. begin
  462.  DisPlayInfo(GetInfoChecked.Checked);
  463. end;
  464. {---------------------------------------------------------------------}
  465. procedure TForm1.CheckBox1Click(Sender: TObject);
  466. {depending on the state of the checkbox, center or not center image}
  467. begin
  468.  MultiImage1.Center:=CheckBox1.Checked;
  469. end;
  470. {---------------------------------------------------------------------}
  471.  
  472. procedure TForm1.BitBtn1Click(Sender: TObject);
  473. var
  474.   RunAfterCreate : Boolean;
  475. begin
  476.     {Create a new message using the message editor}
  477.     {boolean indicating to run the message after creation}
  478.     RunAfterCreate:=True;
  479.  
  480.     {CreateMessage takes a pathname as the initial path to save the
  481.      message and a boolean to run it. For Instance:
  482.     {MultiImage1.CreateMessage('c:\',true);}
  483.     MultiImage1.CreateMessage(ExtractFilePath(Application.Exename),RunAfterCreate);
  484.  
  485.     {Show new message in listbox}
  486.     FileListBox1.Update;
  487. end;
  488. {---------------------------------------------------------------------}
  489.  
  490. procedure TForm1.FormDestroy(Sender: TObject);
  491. begin
  492.    {release memory of the stringlist boxes}
  493.     oldsavefiles.free;
  494.     oldreadfiles.free;
  495. end;
  496. {---------------------------------------------------------------------}
  497.  
  498. procedure TForm1.Cut1Click(Sender: TObject);
  499. begin
  500. {Cut Image and Copy it to the clipboard}
  501.   MultiImage1.CutToClipboard
  502. end;
  503. {---------------------------------------------------------------------}
  504.  
  505. procedure TForm1.Copy1Click(Sender: TObject);
  506. begin
  507. {Copy Image to the clipboard}
  508.   MultiImage1.CopyToClipboard;
  509. end;
  510. {---------------------------------------------------------------------}
  511.  
  512. procedure TForm1.Paste1Click(Sender: TObject);
  513. begin
  514. {Paste Image from the clipboard}
  515.   MultiImage1.PasteFromClipboard;
  516. end;
  517. {---------------------------------------------------------------------}
  518.  
  519. procedure TForm1.ScrollBar1Change(Sender: TObject);
  520. begin
  521.  {Change the speed of a srolling message}
  522.   MultiImage1.MsgSpeed:=ScrollBar1.Position;
  523. end;
  524. {---------------------------------------------------------------------}
  525.  
  526.  
  527. end.
  528.